home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / comm / mmgr / MM_Spectre10.lha / Rexx / MM_Spectre.rexx.cmp < prev    next >
Encoding:
Text File  |  1998-06-22  |  9.1 KB  |  22 lines
  1. /*
  2.  
  3.                      $VER: MM_Spectre  1.0  (22/6/98)
  4.  
  5.                        Copyright ©1998 Neil Williams
  6.  
  7.                   Portions Copyright ©1996 Robert Hofmann
  8.  
  9. */
  10.  
  11. /* Compressed with CompressRexx v3.0 (CMPMODE NORMAL), (C) 1993-96 Robert Hofmann */
  12. parse arg args;options cache;options failat 99;options results;signal on break_c;signal on break_d;signal on break_e;signal on break_f;signal on halt;signal on ioerr;signal on syntax;address 'MAILMANAGER';Main:;call Init;call Header;call Read_Cfg;call Wait_AreasWindow;call Parse;call Quit(0, 'All done.');exit;break_c:;break_d:;break_e:;break_f:;halt:;signal off break_c;signal off break_d;signal off break_e;signal off break_f;signal off halt;return_code = 5;error_line = 0;error_msg = 'Execution halted!!!';rc = 0;signal Exit;Exit:;select;when return_code>=40 then error = 'INTERNAL-ERROR:';when return_code>=30 then error = 'IO-ERROR:';when return_code>=20 then error = 'ERROR:';when return_code>=10 then error = 'WARNING:';when return_code>=5 then error = 'INFO:';otherwise error = '';end;call Log();call Log('***' strip(error error_msg) '***', '+');call Log(,'\');call setclip('MM_LogPre', system.mm.logpre);exit return_code;Wait_AreasWindow: procedure Expose system.;MM_AreasWin;if rc=0 then return;bell = '07'x
  13. cr = '0D'x;if Request_Choice('\c\n\1'system.prg.id'\0 is waiting.\n\nPlease go back to the Areas-Window as soon as possible!\n', '* _WAIT | _QUIT ', '0 1') then call Quit(5, 'Aborted by user.');tmp = 'Waiting for Areas-Window...';call writech(STDOUT, bell || tmp || cr);call Log(tmp,, 4);rc = 1;do while rc~=0;MM_AreasWin;call writech(STDOUT, bell);call Delay(250);end;return;Request_Choice: procedure Expose system.;parse arg text, buttons, ret_vals;title = system.prg.name'-Requester';text = translate(Replace(text, '0A'x, '\n'), '1b'x, '\');if length(text)<40 then text = center(text, 40);MM_Requester title 'text' 'buttons';if rc=0 then rc=words(ret_vals);return compress(word(ret_vals, rc), '_');Get_Arg: procedure Expose args system.;arg keyword, mode, old;uargs = upper(args);p = find(uargs, keyword);if p=0 then do;p = pos(' 'keyword'=', ' 'uargs);if p>0 then args = overlay(' ', args, p+length(keyword));p = find(upper(args), keyword);end;system.cmdopt.keyword = p>0;select;when mode=0 then if p>0 then do;ret = 1
  14. args = delword(args, p, 1);end;else ret = old;when mode=1 then if p>0 then do;left = subword(args, 1, p-1);rest = subword(args, p+1);if left(rest, 1)='"' then parse var rest . '"' ret '"' rest;else parse var rest ret rest;args = strip(left strip(rest));end;else ret = old;when mode=2 then do;if left(args, 1)='"' then parse var args . '"' ret '"' args;else parse var args ret args;if strip(ret)='' then ret = old;end;otherwise exit 99;end;args = strip(args);ret = strip(ret, 'b', '" ');return ret;Get_Version: procedure;parse arg mode;parse value sourceline(3-mode) with . . ver .;parse var ver tst 'ß' .;if ~datatype(strip(tst, 'b', '/c '), 'N') then if ~mode then ver = Get_Version(1);else exit 99;return ver;Header:;call Log(,'/');call Log('***' system.prg.id '***', '+');call Log(' 'system.prg.cr);call Log();return;Init:;system. = 0;system.prg.ver = Get_Version(0);system.prg.name = 'MM_Spectre';system.prg.id = system.prg.name 'v'system.prg.ver;system.prg.cfg = 'MM:Config/'system.prg.name'.cfg'
  15. system.prg.cr = '(C)1998 Neil Williams';system.tmpfile = 'T:'system.prg.name'.tmp';system.mm.logpre = getclip('MM_LogPre');system.prg.logpre = system.mm.logpre'|';system.prg.loglevel = 2;call setclip('MM_LogPre', system.prg.logpre);system.cmdopts = 'OPTIONS';system.names.count = 0;system.areas.count = 0;system.msg.count = 0;call Include_Lib('rexxsupport');return;Include_Lib: procedure Expose system.;parse arg lib, prio;if right(upper(lib), 8)~='.LIBRARY' then lib = lib'.library';if prio='' then prio = 0;if ~show('l', lib) then if ~addlib(lib, prio, -30, 0) then call Quit(20, 'Could not open' lib'!!!');return;IOerr:;signal off ioerr;return_code = 20;error_line = sigl;error_msg = 'IO-error' rc 'at line' sigl '['errortext(rc)']');rc = 0;signal Exit;Log: procedure Expose system.;parse arg text, pre, level;if ~datatype(level, 'N') then level = system.prg.loglevel;tmp = word('PRG MM', (pre~='')+1);text = system.tmp.logpre || pre' 'text;MM_WriteLog 'text' level;return;Quit:;parse arg return_code, error_msg
  16. error_line = 0;rc = 0;signal Exit;Read_Cfg: procedure Expose system.;MM_ReadStem system.prg.cfg 'cfg';if RC~=0 then call Quit(31, 'Unable to read' system.prg.cfg'!!!');call Log('Reading config...');cnt = 0;do l=0 to cfg.count-1;parse value strip(translate(cfg.l, ' ', '9'x)) with key args ';' .;key = upper(strip(key));if key~='#MSG' then args = strip(args);select;when key='' then iterate;when key='#AREA' then do;i = system.areas.count;system.areas.i.check = word( args, 1 );if word( args, 2 ) ~= '' then system.areas.i.reply = word( args, 2 );else;system.areas.i.reply = system.areas.i.check;system.areas.count = system.areas.count+1;end;when key='#NAME' then do;i = system.names.count;system.names.i = args;system.names.count = system.names.count+1;end;when key='#NETMAIL' then system.areas.netmail = 1;when key='#MSG' then do;i=system.msg.count;system.msg.i = args;system.msg.count = system.msg.count+1;end;when key='#LOG' then system.logfile = args;otherwise say '*** CFG-ERROR: Unknown keword "'key'" at line' l'!!!'
  17. end;cnt = cnt+1;end;return;Replace: procedure;parse arg string, new, old;do while index(string, old) ~= 0;interpret "parse var string l '"old"' r";string = l || new || r;end;return string;Syntax:;signal off syntax;return_code = 40;error_line = sigl;error_msg = 'Syntax-error' rc 'at line' sigl '['errortext(rc)']';rc = 0;signal Exit;Usage:;rx. = '';rx.0.0 = '[rx] ';rx.0.1 = '[.rexx]';m = pos('/e', system.prg.ver)>0;say;say 'Usage:' rx.m.0 || system.prg.name || rx.m.1 system.cmdopts;say;call Quit(0, 'Usage requested.');Parse: procedure Expose system.;call log( 'Checking areas...' );totalmsgs = 0;do i = 0 to system.areas.count-1;do j = 0 to system.names.count-1;MM_SearchMsgs system.areas.i.check 'msgs' '#?' '"'system.names.j'"' '#?' '!SENT';if RC = 0 then do;do k = 0 to msgs.count-1;totalmsgs = totalmsgs + 1;call Reply( system.areas.i.check, msgs.k, system.areas.i.reply );end;end;end;end;if system.areas.netmail ~= 'SYSTEM.AREAS.NETMAIL' then do;MM_GetAreas mailareas 'MAIL';do a = 0 to mailareas.count-1
  18. do j = 0 to system.names.count-1;MM_SearchMsgs mailareas.a 'msgs' '#?' '"'system.names.j'"' '#?' '!SENT';if RC = 0 then do;do k = 0 to msgs.count-1;totalmsgs = totalmsgs + 1;call Reply( mailareas.a, msgs.k, mailareas.a );end;end;end;end;end;call log( 'Replied to '|| totalmsgs ||' messages.' );return;Reply: procedure Expose system.;parse arg area, num, replyarea;MM_ReadMsg area num 'rmsg';if RC = 0 then do;do q = 0 to rmsg.head.count-1;select;when left( rmsg.head.q, 7 ) = '1'x || 'MSGID: ' then do;replyid = right( rmsg.head.q, length( rmsg.head.q )-8 );end;when left( rmsg.head.q, 11 ) = '1'x || 'REPLYADDR ' then do;replyaddr = word( rmsg.head.q, 2 );end;when left( rmsg.head.q, 9 ) = '1'x || 'REPLYTO ' then do;replytoaddr = word( rmsg.head.q, 2 );replytoname = word( rmsg.head.q, 3 );end;otherwise nop;end;end;if Open('fh', system.tmpfile, 'W') then do;if replyid ~= 'REPLYID' then call writeln('fh', '1'x || 'REPLY: '||replyid );if replyaddr ~= 'REPLYADDR' then do;call writeln('fh', 'To: '||replyaddr )
  19. call writeln('fh', '');end;do w = 0 to system.msg.count-1;line = replace( system.msg.w, area, '%AREA' );line = replace( line, rmsg.from, '%FROM' );line = replace( line, rmsg.fromaddr, '%FROMADDR' );line = replace( line, rmsg.to, '%TO' );line = replace( line, rmsg.toaddr, '%TOADDR' );line = replace( line, rmsg.subj, '%SUBJECT' );line = replace( line, rmsg.date, '%DATE' );line = replace( line, Date(), '%CURRENTDATE' );line = replace( line, Time(), '%CURRENTTIME' );writeln('fh', line);end;call Close('fh');drop wmsg.;MM_GetSysop sysop;MM_GetAreaInfo replyarea areainfo;wmsg.from = sysop;wmsg.fromaddr = areainfo.addr;if replytoname ~= 'REPLYTONAME' then fromn = replytoname;else;fromn = rmsg.from;if replytoaddr ~= 'REPLYTOADDR' then froma = replytoaddr;else;froma = rmsg.fromaddr;wmsg.to = fromn;wmsg.toaddr = froma;wmsg.subj = rmsg.subj;if areainfo.type = 'MAIL' then wmsg.flags = 'PVT';else;wmsg.flags = '';wmsg.file = system.tmpfile;wmsg.tear = system.prg.id;MM_WriteMsg replyarea wmsg
  20. if system.logfile ~= 'SYSTEM.LOGFILE' then do;o = 0;if exists( system.logfile ) = 0 then do;call Open('m', system.logfile, 'W');o = 1;end;else do;call Open('m', system.logfile, 'A');o = 1;end;if o then do;writeln('m', '');writeln('m', '--------------------------------------------------------------------------');writeln('m', 'Area: 'area'   Dated: 'rmsg.date);writeln('m', 'From: 'rmsg.from'   <'rmsg.fromaddr'>');writeln('m', 'To  : 'rmsg.to'   <'rmsg.toaddr'>');writeln('m', 'Subject: 'rmsg.subj'   Flags: 'rmsg.flags);writeln('m', 'Arrived: 'Time()' 'Date());writeln('m', '--------------------------------------------------------------------------');do t = 0 to rmsg.head.count-1;writeln('m', rmsg.head.t);end;do t = 0 to rmsg.text.count-1;writeln('m', rmsg.text.t);end;do t = 0 to rmsg.foot.count-1;writeln('m', rmsg.foot.t);end;Call Close( 'm' );end;end;end;end;return
  21. /* Original script: 518 lines, 10608 bytes, cmprate 15.4% */
  22.